home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Prog / A / Acius09⁄92 / TN 30ƒ / Ext4D_LineStarts.p < prev    next >
Encoding:
Text File  |  1992-09-30  |  9.0 KB  |  369 lines  |  [TEXT/MWII]
  1. {===================================================================================================}
  2. {
  3.     Text to array external commands for 4th DIMENSION 2.x.x
  4.     by Dominique Hermsdorff
  5.     ©1991 ACI,ACIUS Inc.
  6.     
  7.     To work with this source code, you have to be familiar with the Text Edit Manager, see the
  8.     relevant Inside Macintosh volumes in this purpose.
  9.     
  10.  
  11.     About the Line Starts external commands...
  12.     
  13.     These commands and the source code are provided to you for your information.
  14.     They are intended to help you in the implementation of your own external commands.
  15.     They are not intended to be used as is, in final applications.
  16.     
  17.     If you would like to use these commands inside your applications, please use,
  18.     or contact a developer able to use, the source code provided as a template
  19.     to build your own commands.
  20.     
  21.     Note: ACI and ACIUS Technical Support do not provide support for these external commands.
  22.     
  23. }
  24. {===================================================================================================}
  25.  
  26.  
  27. UNIT Ext4D_LineStarts;
  28.  
  29. {$IFC Undefined THINK_PASCAL }
  30.     {$D- }
  31.     {$R- }
  32. {$ENDC }
  33.  
  34. INTERFACE
  35.  
  36. {$IFC Undefined THINK_PASCAL }
  37.     Uses    MemTypes,
  38.                 QuickDraw,
  39.                 OSIntf,
  40.                 ToolIntf,
  41.                 PackIntf,
  42.                 Events,
  43.                 SysEqu,
  44.                 Traps,
  45.                 Ext4DIntf;
  46. {$ENDC}
  47.  
  48. {$IFC Undefined THINK_PASCAL }
  49.     {$SETC DebugOn = TRUE }
  50.     {$IFC DebugOn }
  51.         {$D+ }
  52.         {$R+ }
  53.     {$ELSEC }
  54.         {$D- }
  55.         {$R- }
  56.     {$ENDC }
  57. {$ENDC }
  58.  
  59. {$IFC UNDEFINED THINK_PASCAL }
  60.     {$R- }
  61. {$ENDC }
  62.  
  63.  
  64.     
  65. PROCEDURE CALL_LINESTARTSPACK(ProcNum:LongInt;Params:ParamsTabPtr;Var Data:Handle;Var FuncPtr:Ptr);
  66.  
  67. IMPLEMENTATION
  68.  
  69. CONST        kLineStarts                                            =    1;
  70.                 kGETFONTINFO                                        =    2;
  71.                 
  72.                 
  73.                 
  74.                 kErrTextIsEmpty                                    =    1;
  75.                 kErrThisIsNotaText                            = 2;
  76.                 kErrBadSize                                            = 3;
  77.                 kErrWasExpectingAnArrayOfLong        = 4;
  78.                 kErrWidthIsTooSmall                            = 5;
  79.                 
  80.                 
  81.                 OKButton                                                =    1;
  82.                 DevToolDlgID                                        =    0;
  83.                 
  84.         
  85. PROCEDURE LINESTARTSPACK(ProcNum:LongInt;Params:ParamsTabPtr;Var PackData:Handle;Var FuncPtr:Ptr);FORWARD;
  86.  
  87. PROCEDURE CALL_LINESTARTSPACK(ProcNum:LongInt;Params:ParamsTabPtr;Var Data:Handle;Var FuncPtr:Ptr);
  88. BEGIN
  89.     LINESTARTSPACK(ProcNum,Params,Data,FuncPtr);
  90. END; { CALL_LINESTARTSPACK }
  91.  
  92. FUNCTION Integer2Style(Style4D:Integer):Style; InLine $301F,$7208,$E368,$3E80;    {    MOVE.W    (A7)+,D0
  93.                                                                                                                                                                     MOVEQ        #$08,D1
  94.                                                                                                                                                                     LSL.W        D1,D0
  95.                                                                                                                                                                     MOVE.W    D0,(A7) }
  96. PROCEDURE    MySetCursor(WhichCursor:INTEGER);
  97. BEGIN
  98.     SetCursor(GetCursor(GetResNum('4BNX','CURS',WhichCursor))^^);
  99. END; { MySetCursor }
  100.  
  101. {$I    Ext4D_DevTools_Dlg.p }
  102.  
  103. PROCEDURE Clear4DArray(anArray:VarRecPtr);
  104. VAR    z:LongInt;
  105.         h:Handle;
  106.         s:StringPtr;
  107. BEGIN
  108.     WITH anArray^ DO
  109.     BEGIN
  110.         IF NbElem>0 THEN
  111.         BEGIN
  112.             IF VarKind=TabAlpha THEN
  113.             BEGIN
  114.                 IF TabAlphaH<>NIL THEN
  115.                 BEGIN
  116.                     FOR z:=0 TO NbElem DO
  117.                     BEGIN
  118.                         h:=Handle(TabAlphaH^^[z].CC);
  119.                         IF h<>NIL THEN DisposHandle(h);
  120.                     END;
  121.                 END;
  122.             END
  123.             ELSE
  124.             BEGIN
  125.                 IF VarKind=TabPict THEN
  126.                 BEGIN
  127.                     FOR z:=0 TO NbElem DO
  128.                     BEGIN
  129.                         h:=Handle(TabPictH^^[z]);
  130.                         IF h<>NIL THEN DisposHandle(h);
  131.                     END;
  132.                 END;
  133.             END;
  134.             CASE VarKind OF
  135.                 TabInt            : z:=SizeOf(Integer);
  136.                 TabLong            : z:=SizeOf(LongInt);
  137.                 TabNum            : z:=SizeOf(Extended);
  138.                 TabAlpha        :    z:=SizeOf(TE4D);
  139.                 TabPict            :    z:=SizeOf(PicHandle);
  140.                 TabDate            : z:=SizeOf(Date4D);
  141.                 TabBool            : z:=2;
  142.                 TabStrFix        : BEGIN
  143.                                                 z:=ORD4(TabFixH^^.LenFix);
  144.                                                 IF ODD(z) THEN z:=z+1;
  145.                                                 z:=z+2;
  146.                                             END;
  147.             END;
  148.             IF TabIntH<>NIL THEN SetHandleSize(Handle(TabIntH),z);                    
  149.             NbElem:=0;
  150.             CurSel:=0;
  151.             CASE VarKind OF
  152.                 TabBool,
  153.                 TabInt            : TabIntH^^[0]:=0;
  154.                 TabLong            : TabLongH^^[0]:=0;
  155.                 TabNum            : TabNumH^^[0]:=0;
  156.                 TabAlpha        :    WITH TabAlphaH^^[0] DO
  157.                                             BEGIN
  158.                                                 Len:=0;
  159.                                                 CC:=NIL;
  160.                                             END;
  161.                 TabPict            :    TabPictH^^[0]:=NIL;
  162.                 TabDate            : WITH TabDateH^^[0] DO
  163.                                             BEGIN
  164.                                                 Day:=0;
  165.                                                 Month:=0;
  166.                                                 Year:=0;
  167.                                             END;
  168.                 TabStrFix        : BEGIN
  169.                                                 s:=StringPtr(ORD4(TabFixH^)+2);
  170.                                                 s^:='';
  171.                                             END;
  172.             END;
  173.         END;
  174.     END;
  175. END; { Clear4DArray }
  176.  
  177. FUNCTION Resize4DArray(anArray:VarRecPtr;Nb:LongInt):INTEGER;
  178. TYPE    IntegerHandle = ^IntegerPtr;
  179. VAR n:INTEGER;
  180.         z:LongInt;
  181.         h:Handle;
  182. BEGIN
  183.     Resize4DArray:=NoErr;
  184.     Clear4DArray(anArray);
  185.     WITH anArray^ DO
  186.     BEGIN
  187.         Nb:=Nb+1;
  188.         CASE VarKind OF
  189.             TabInt            : z:=Nb*SizeOf(INTEGER);
  190.             TabLong            : z:=Nb*SizeOf(LongInt);
  191.             TabNum            : z:=Nb*SizeOf(Extended);
  192.             TabAlpha        :    z:=Nb*SizeOf(TE4D);
  193.             TabPict            :    z:=Nb*SizeOf(PicHandle);
  194.             TabDate            : z:=Nb*SizeOf(Date4D);
  195.             TabBool            : z:=2+(Nb DIV 8);
  196.             TabStrFix        : BEGIN
  197.                                             n:=TabFixH^^.LenFix;
  198.                                             z:=ORD4(n);
  199.                                             IF ODD(z) THEN z:=z+1;
  200.                                             z:=2+(Nb*z);
  201.                                         END;
  202.         END;
  203.         Nb:=Nb-1;
  204.         h:=NewHandleClear(z);
  205.         IF h<>NIL THEN
  206.         BEGIN
  207.             IF TabIntH<>NIL THEN DisposHandle(Handle(TabIntH));
  208.             TabIntH:=TabOfIntHandle(h);
  209.             NbElem:=Nb;
  210.             CurSel:=0;
  211.             IF VarKind=TabStrFix THEN IntegerHandle(TabFixH)^^:=n;
  212.         END
  213.         ELSE Resize4DArray:=MemFullErr;
  214.     END;
  215. END; { Resize4DArray }
  216.  
  217. FUNCTION FontNameToFontID(NameOfFont:StringPtr):INTEGER;
  218. VAR    I:INTEGER;
  219.         L:LongInt;
  220. BEGIN
  221.     IF Length(NameOfFont^)>0 THEN
  222.     BEGIN
  223.         IF NameOfFont^[1]='#' THEN
  224.         BEGIN
  225.             StringToNum(COPY(NameOfFont^,2,Length(NameOfFont^)-1),L);
  226.             FontNameToFontID:=ORD(L);
  227.         END
  228.         ELSE
  229.         BEGIN
  230.             GetFNum(NameOfFont^,I);
  231.             FontNameToFontID:=I;
  232.         END;
  233.     END
  234.     ELSE FontNameToFontID:=0;
  235. END; { FontNameToFontID }
  236.  
  237. PROCEDURE LINESTARTSPACK;
  238.         
  239.     FUNCTION DoLINESTARTS(TheText:Te4DPtr;TheFont:StringPtr;
  240.                                                 TheSize,TheStyle,TheWidth:INTEGER;ThePositions:VarRecPtr):INTEGER;
  241.     VAR ErrCode,Len,Count:INTEGER;
  242.             MyTE:TEHandle;
  243.             H:Handle;
  244.             CurPort:GrafPtr;
  245.             MyRect:Rect;
  246.             MyFont:FontInfo;
  247.             MyPort:GrafPort;
  248.     BEGIN
  249.         ErrCode:=NoErr;
  250.         IF (0<TheSize) & (TheSize<=255) THEN
  251.         BEGIN
  252.             IF ThePositions^.VarKind=TabLong THEN
  253.             BEGIN
  254.                 IF TheText^.Len>=0 THEN
  255.                 BEGIN
  256.                     IF TheText^.CC<>NIL THEN
  257.                     BEGIN
  258.                         Len:=ORD(GetHandleSize(Handle(TheText^.CC)));
  259.                         IF Len>0 THEN
  260.                         BEGIN
  261.                             Clear4DArray(ThePositions);
  262.                             GetPort(CurPort);
  263.                             OpenPort(@MyPort);
  264.                             WITH MyPort DO
  265.                             BEGIN
  266.                                 SetEmptyRgn(ClipRgn);
  267.                                 SetEmptyRgn(VisRgn);
  268.                             END;
  269.                             TextFont(FontNameToFontID(TheFont));
  270.                             TextSize(TheSize);
  271.                             TextFace(Integer2Style(TheStyle));
  272.                             GetFontInfo(MyFont);
  273.                             IF TheWidth>MyFont.widMax THEN
  274.                             BEGIN
  275.                                 SetRect(MyRect,0,0,TheWidth,342);
  276.                                 MyTE:=TENew(MyRect,MyRect);
  277.                                 IF MyTE<>NIL THEN
  278.                                 BEGIN
  279.                                     H:=MyTE^^.hText;
  280.                                     MyTE^^.hText:=Handle(TheText^.CC);
  281.                                     TECalText(MyTE);
  282.                                     MyTE^^.hText:=H;
  283.                                     ErrCode:=Resize4DArray(ThePositions,ORD4(1+MyTE^^.nLines));
  284.                                     IF ErrCode=NoErr THEN
  285.                                     BEGIN
  286.                                         FOR Count:=1 TO (MyTE^^.nLines+1) DO 
  287.                                           ThePositions^.TabLongH^^[Count]:=1+MyTE^^.LineStarts[Count-1];
  288.                                     END;
  289.                                     TEDispose(MyTE);
  290.                                 END
  291.                                 ELSE ErrCode:=MemFullErr;
  292.                             END
  293.                             ELSE
  294.                             BEGIN
  295.                                 TheWidth:=MyFont.WidMax;
  296.                                 ErrCode:=kErrWidthIsTooSmall;
  297.                             END;
  298.                             SetPort(CurPort);
  299.                             ClosePort(@MyPort);
  300.                         END
  301.                         ELSE ErrCode:=kErrTextIsEmpty;
  302.                     END
  303.                     ELSE ErrCode:=kErrTextIsEmpty;
  304.                 END
  305.                 ELSE ErrCode:=kErrThisIsNotaText;
  306.             END
  307.             ELSE ErrCode:=kErrWasExpectingAnArrayOfLong;
  308.         END
  309.         ELSE ErrCode:=kErrBadSize;
  310.         DoLINESTARTS:=ErrCode;
  311.     END; { DoLINESTARTS }
  312.     
  313.     PROCEDURE DoGetFontInfo(TheFont:StringPtr;TheSize,TheStyle:INTEGER;
  314.                                                    VAR FAscent,FDescent,FLeading,FWidMax:LongInt);
  315.     VAR    CurPort:GrafPtr;
  316.             MyFont:FontInfo;
  317.             MyPort:GrafPort;
  318.     BEGIN
  319.         GetPort(CurPort);
  320.         OpenPort(@MyPort);
  321.         TextFont(FontNameToFontID(TheFont));
  322.         TextSize(TheSize);
  323.         TextFace(Integer2Style(TheStyle));
  324.         GetFontInfo(MyFont);
  325.         WITH MyFont DO
  326.         BEGIN
  327.             FAscent:=ORD4(Ascent);
  328.             FDescent:=ORD4(Descent);
  329.             FLeading:=ORD4(Leading);
  330.             FWidMax:=ORD4(WidMax);
  331.     END;
  332.         SetPort(CurPort);
  333.         ClosePort(@MyPort);
  334.     END; { DoGetFontInfo }
  335.     
  336. BEGIN { LINESTARTSPACK }
  337.     IF ProcNum>0 THEN
  338.     BEGIN
  339.         CASE ProcNum OF
  340.         
  341.                 { Line starts(Text;Font;FontSize;FontStyle;Width;Positions) -> OS Error
  342.                     Line starts(&T;&S;&L;&L;&L;&X):L }
  343.             kLineStarts:
  344.                 FuncPtr:=Ptr(ORD4(DoLINESTARTS(Te4DPtr(Params^[1]),
  345.                                                StringPtr(Params^[2]),
  346.                                                                              ORD(LongIntPtr(Params^[3])^),
  347.                                                                              ORD(LongIntPtr(Params^[4])^),
  348.                                                                              ORD(LongIntPtr(Params^[5])^),
  349.                                                                              VarRecPtr(Params^[6]))));
  350.                                                                              
  351.                 { GET FONT INFO(Font;FontSize;FontStyle;FAscent;FDescent;FLeading;FWidMax)
  352.                   GET FONT INFO(&S;&L;&L;&L;&L;&L;&L) }
  353.             kGetFontInfo:
  354.                 DoGetFontInfo(StringPtr(Params^[1]),
  355.                                             ORD(LongIntPtr(Params^[2])^),
  356.                                             ORD(LongIntPtr(Params^[3])^),
  357.                                             LongIntPtr(Params^[4])^,
  358.                                             LongIntPtr(Params^[5])^,
  359.                                             LongIntPtr(Params^[6])^,
  360.                                             LongIntPtr(Params^[7])^);
  361.             
  362.             
  363.         END; { CASE ProcNum OF }
  364.     END
  365.     ELSE IF ProcNum=Init4DPackage THEN ShowDevToolDlg;
  366. END; { LINESTARTSPACK }
  367.  
  368. END. { UNIT Ext4D_LineStarts }
  369.